home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / astronom / skyscape / skyscape.bas
Encoding:
BASIC Source File  |  1993-07-06  |  16.0 KB  |  341 lines
  1. 100   rem ** Skyscape ** Compute Dec 1985 ** Atari ST version by Jeff Johnson
  2. 101   rem ** Compute didn't want to publish this ST version so I'm
  3. 102   rem ** putting it in the public domain.  Enjoy it.  Jeff.
  4. 110   clearw(2):fullw(2):poke contrl,14:poke contrl+2,0
  5. 120   poke contrl+6,4:poke intin,3:poke intin+2,0
  6. 130   poke intin+4,0:poke intin+6,1000:vdisys
  7. 140   gosub 3100:gotoxy 20,16:color 2:? "Press any key to continue!";:i$=input$(1)
  8. 150   color 1
  9. 160   d$="000031059090120151181212243273304334":k1=1440:dim hc%(22):mm$="041079040
  10. 170   m$="286317345011041072102133164194225255":d$(1)="S":d$(2)="N":es=93
  11. 180   a$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC":oo$="OUT OF RANGE!":dg$=chr$(248)
  12. 190   md$="312831303130313130313031":d9=atn(1)/45
  13. 200   read ee:read m9:dim p(6,6),screen%(40,14)
  14. 210   def fnr(x)=int(x*10+.5)/10
  15. 220   def fns(x)=int(x*100+.5)/100
  16. 230   for y=1 to 2:for x=1 to 6:read p(x,y):next:next:y=0
  17. 240   for x=1 to 6:read p$(x),p(x,3):next
  18. 250   for x=1 to 7:read pp(x):next
  19. 260   j$="SATSUNMONTUEWEDTHUFRI":for x=1 to 12:read f$
  20. 270   cc$=cc$+"      "+f$:next:cc$=cc$+cc$:f$=right$(cc$,9):cc$=f$+cc$
  21. 280   for x=1 to 8:read ph$(x):next
  22. 290   for x=1 to 22:read hc%(x):next:goto 1200
  23. 300   cc=mt-720:if cc<0 then cc=cc+k1
  24. 310   cc=cc/120:cd=cc-int(cc):cc=int(cc):cd=int(cd*7+.2):cc=81-(cc*7+cd)
  25. 320   gosub 2440:if ll<0 then gosub 2980
  26. 330   print cd$:return
  27. 340   gosub 3060
  28. 350   gotoxy sl,4:? "** DAY'S SKY **":gotoxy sl,5:? "--------------"
  29. 360   gotoxy sl,7:? "INPUT THE TIME:":gotoxy sl,8:? "--------------"
  30. 370   gotoxy sl,9:? "HOUR (0-23)";:gosub 2810:if i$<>"" then t1=val(i$)
  31. 380   if t1<0 or t1>23 then gotoxy sl+3,10:? oo$:goto 370
  32. 390   gotoxy sl,11:? "MINUTE (0-59)";:gosub 2810:if i$<>"" then t2=val(i$)
  33. 400   if t2<0 or t2>59 then gotoxy sl,12:? oo$:goto 390
  34. 410   r$=right$(str$(t1),2):t$=str$(t2):if t2<10 then t$="0"+right$(t$,1)
  35. 420   t$=right$(t$,2)
  36. 430   gotoxy sl,14:? "TIME-- "r$":"t$
  37. 440   gotoxy 20,17:gosub 2590:if i$="N" or i$="n" then 340
  38. 450   color 1:clearw(2):t3=t1*60+t2+aa-720:if t3<0 then t3=t3+k1
  39. 460   if t3>k1 then t3=t3-k1
  40. 470   mt=t3-360:if mt<0 then mt=mt+k1
  41. 480   pt=t3+360:if pt>k1 then pt=pt-k1
  42. 490   poke contrl,32:poke contrl+2,0:poke contrl+6,1:rem trasparent write
  43. 500   poke intin,2:vdisys
  44. 510   gotoxy 5,0:? "--DAY'S SKY--  ";:gosub 2190:tim$="  "+r$+":"+t$
  45. 520   gotoxy 0,0:?:gotoxy 39,0:? tim$
  46. 530   for i=0 to 13:for j=0 to 39:screen%(j,i)=0:next:next
  47. 540   c=3:color 1:tm=val(r$+"."+t$):if tm<6 or tm>18 then c=1:color 3
  48. 550   poke contrl,25:poke contrl+2,0:poke contrl+6,1:rem set fill color
  49. 560   poke intin,c:vdisys
  50. 570   poke contrl,9:poke contrl+2,5:poke contrl+6,0:rem filled rectangle
  51. 580   restore 3040:for i=0 to 9:read zz:poke ptsin+i*2,zz:next
  52. 590   vdisys
  53. 600   xx=7+lc:gotoxy 5,xx
  54. 610   ? " - - - - - - - - - - - - - - - - - - - - - - "
  55. 620   poke contrl,25:poke contrl+2,0:poke contrl+6,1:rem change color
  56. 630   poke intin,2:vdisys
  57. 640   poke contrl,9:poke contrl+2,5:poke contrl+6,0:rem filled rectangle
  58. 650   restore 3050:for i=0 to 9:read zz:poke ptsin+i*2,zz:next
  59. 660   vdisys
  60. 670   gotoxy 5,15:color 1:gosub 300:gotoxy 5,16:color 0:if ll<0 then 700
  61. 680   if ll>24 then ? "E"spc(21)"S"spc(21)"W":goto 720
  62. 690   ? "UP-NORTH       ----OVERHEAD        DOWN-SOUTH":goto 720
  63. 700   if ll<-24 then ? "E"spc(21)"N"spc(21)"W":goto 720
  64. 710   ? "UP-SOUTH       ----OVERHEAD        DOWN-NORTH"
  65. 720   t4=aa:gosub 1100:y8=888
  66. 730   if y9=999 then 800
  67. 740   gosub 2820:y8=y9:if a1<0 then 800
  68. 750   if u9>17 or u9<4 then 800
  69. 760   u9=u9-3:y9=y9+15
  70. 770   gotoxy 0,0:?
  71. 780   screen%(54-y9,u9-2)=1
  72. 790   color 0:gotoxy 59-y9,u9:?chr$(42)
  73. 800   t4=aa+m2*k1:if t4>k1 then t4=t4-k1
  74. 810   color 1:if tm<6 or tm>18 then color 3
  75. 820   gosub 1100:if y9=999 then 880
  76. 830   mm=int(m1/9.83333)+1:gosub 1180
  77. 840   gosub 2820:if u9>17 or u9<4 then 880
  78. 850   u9=u9-3:y9=y9+15
  79. 860   screen%(54-y9,u9-2)=1
  80. 870   gotoxy 59-y9,u9:? chr$(mm)
  81. 880   for x=1 to 7:if x=7 then gosub 2710
  82. 890   if right$(b$,5)="COMET" and x=7 then 930
  83. 900   if x=7 then 1000
  84. 910   t4=p(x,6):gosub 1100:if y9=999 then 1000
  85. 920   u9=sin((p(x,6)/4)/(1/d9)):u9=int(-3*u9+.5)
  86. 930   gosub 2830
  87. 940   if u9<4 or u9>17 then 1000
  88. 950   u9=u9-3:y9=y9+15
  89. 960   z=screen%(54-y9,u9-2)
  90. 970   if z then u9=u9+sgn(ll)+(ll=0):goto 960
  91. 980   screen%(54-y9,u9-2)=1
  92. 990   gotoxy 59-y9,u9:? chr$(pp(x));
  93. 1000  rem dummy line
  94. 1010  next:color 1:gotoxy 40,17:? chr$(42);:gotoxy 0,0:?
  95. 1020  gotoxy 1,17:color 3:for x=1 to 6:?chr$(pp(x));p$(x);" ";:next
  96. 1030  ? " *SUN )O(MOON";
  97. 1040  gotoxy 0,0:?:gotoxy 40,17:? "ONEW MOON+SUN ";b$;:gotoxy 0,0:?
  98. 1050  color 2:gotoxy 47,15:? "T- NEW TIME, D- DATE,"
  99. 1060  gotoxy 47,16:? "P- P. TABLE, L- LAT";:sl=49
  100. 1070  poke contrl,32:poke contrl+2,0:poke contrl+6,1:rem normal write
  101. 1080  poke intin,1:vdisys
  102. 1090  color 1:goto 2360
  103. 1100  y9=999:if mt<pt then 1140
  104. 1110  if t4<mt and t4>pt then return
  105. 1120  if t4<mt or t4>k1 then t4=t4+k1
  106. 1130  goto 1150
  107. 1140  if t4<mt or t4>pt then return
  108. 1150  y9=int((t4-mt)/18+.5):if y9=40 then y9=39
  109. 1160  return
  110. 1170  u9=sin((t4/4)/(1/d9)):u9=int(-3*u9+.5):return
  111. 1180  mm=val(mid$(mm$,3*mm-2,3)):if l<0 and mm<>81 then mm=abs(mm-81)
  112. 1190  return
  113. 1200  color 1:clearw(2):gotoxy 15,0:? "************** SKYSCAPE **************"
  114. 1210  gotoxy 10,2:? "DATE INPUT":s1=0
  115. 1220  gotoxy 10,3:? "----------":if y<>0 then gotoxy 38,2:gosub 2190
  116. 1230  gotoxy 4,5:? "YEAR";:gosub 2810:if i$<>"" then y=val(i$)
  117. 1240  if y<1977 then ? "MUST BE AFTER 1977":goto 1230
  118. 1250  gosub 2260:gotoxy 4,7:? "MONTH (1-12)";:gosub 2810:if i$<>"" then m=val(i$)
  119. 1260  if m<1 or m>12 then ? oo$:goto 1250
  120. 1270  di=val(mid$(md$,2*m-1,2)):di=di-(m=2)*ly:di$=str$(di)
  121. 1280  gotoxy 4,9:? "DAY (1-"di$")";:gosub 2810:if i$<>"" then d=val(i$)
  122. 1290  if d<1 or d>di then ? oo$:goto 1280
  123. 1300  h$=mid$(a$,(m*3)-2,3):gotoxy 4,11:? "LATTITUDE (0-90)";:gosub 2810
  124. 1310  if i$<>"" then ll=val(i$)
  125. 1320  gosub 2860
  126. 1330  if abs(ll)>90 then ? oo$:goto 1300
  127. 1340  d1=val(mid$(d$,(m*3)-2,3))+d:gosub 2300:if m>2 then d1=d1+ly:y1=y1+ly
  128. 1350  s=0:gosub 1930:gotoxy 38,2:gosub 2190:gotoxy 38,3:? "----------------------
  129. 1360  gotoxy 20,17:gosub 2590:if i$="N" or i$="n" then 1200
  130. 1370  gotoxy 20,17:? "                                  ";
  131. 1380  d2=val(mid$(m$,(m*3)-2,3))+d:gosub 2300:if m>2 then d1=d1+ly:y1=y1+ly
  132. 1390  d3=d2-185:if m=3 and d<20 then d2=d2+ly:d3=d3+ly
  133. 1400  if d3<=0 then a=180*d2/185:goto 1420
  134. 1410  a=(180*d3/(180+zy))+180
  135. 1420  if a<180 then s=23.43333*sin(d9*d2*180/185)
  136. 1430  if a>180 then s=-23.43333*(sin(d9*d3))
  137. 1440  if a>=360 then a=a-360
  138. 1450  a=fnr(a)
  139. 1460  s=fnr(s):a1=(sgn(ll)-(ll=0))*s+90-abs(ll):a1=fnr(a1):gosub 1880:gosub 1830
  140. 1470  w=1-(ll<0):if a1>90 then a1=180-a1:w=3-w
  141. 1480  gotoxy 0,0:?
  142. 1490  gotoxy 32,6:? "DAY OF THE YEAR-----------    ";d1
  143. 1500  gotoxy 32,7:? "SUN'S GEOCENTRIC ANGLE----    ";str$(a);dg$
  144. 1510  gotoxy 32,8:? "SUN'S DECLINATION---------    ";str$(s);dg$
  145. 1520  gotoxy 32,9:? "SUN'S ALTITUDE AT NOON----    ";str$(a1);dg$;d$(w)
  146. 1530  gotoxy 32,10:? "SUN'S RIGHT ASCENSION-----    ";a3$
  147. 1540  gotoxy 32,11:? "R.A. AT 9:00PM------------    ";a5$
  148. 1550  gotoxy 32,12:? "MOON'S AGE----------------    ";str$(m1);"DY"
  149. 1560  gotoxy 32,13:? "MOON'S ELONGATION---------    ";str$(m8);dg$;l$
  150. 1570  gotoxy 32,14:? "MOON'S PHASE - "ph$(m3)
  151. 1580  gotoxy 20,17:? "-P- PLANET TABLE, -D- NEW DATE";:goto 2360
  152. 1590  color 1:clearw(2):gotoxy 20,0:? "SKYSCAPE-   ";:gosub 2190:s1=1
  153. 1600  gotoxy 10,1:?" "
  154. 1610  gotoxy 10,2:? "** PLANET TABLE **":gotoxy 10,3:? "------------------"
  155. 1620  gotoxy 2,4:? "PLANET   DIST.  ANG. W/ SUN     R.A."
  156. 1630  gotoxy 2,5:? "------------------------------------"
  157. 1640  for x=1 to 6:a2=y1/p(x,2)-int(y1/p(x,2)):q3=1
  158. 1650  a2=(a2*360)+p(x,1):if a2>360 then a2=a2-360
  159. 1660  e=180+a:if e>360 then e=e-360
  160. 1670  e1=abs(e-a2):if e1>180 then e1=360-e1
  161. 1680  gosub 1950:e1=e1*d9:p5=p(x,3):if x=3 then gosub 2420
  162. 1690  p(x,4)=sqr(1+p5^2-2*p5*cos(e1)):xx=((p5^2-1-p(x,4)^2)/(-2*p(x,4)))
  163. 1700  p(x,5)=-atn(xx/sqr(-xx*xx+1))+atn(1)*2:p(x,4)=int(p(x,4)*93+.5)
  164. 1710  p(x,5)=p(x,5)/d9
  165. 1720  p(x,5)=fns(p(x,5)):q1$=str$(p(x,4)):q2$=str$(p(x,5))
  166. 1730  q1=len(q1$):q2=len(q2$):gosub 2050
  167. 1740  gotoxy 2,x+5:? p$(x);tab(16-q1);q1$;tab(26-q2);q2$;:if q3=-1 then ? dg$"W";
  168. 1750  if q3=1 then ? dg$"E";
  169. 1760  gosub 2100:q4$=str$(q4):q5$=str$(q5):if q5<10 then q5$="0"+right$(q5$,1)
  170. 1770  q5$=right$(q5$,2):q4$=q4$+":"+q5$:z=len(q4$)
  171. 1780  ? tab(30);qq$;tab(38-z);q4$:next:gotoxy 2,13:? "* - VISIBLE AT 9 P.M."
  172. 1790  gotoxy 2,14:? "SUN'S R.A. -------";spc(q8);a3$
  173. 1800  gotoxy 2,15:? "R.A. at 9:00PM ---";spc(q9);a5$
  174. 1810  sl=46:gotoxy 20,17:? "-S- FOR DAY'S SKY, -D- FOR NEW DATE";
  175. 1820  gotoxy 0,0:?:goto 2360
  176. 1830  a2=k1*a/360:if a2>k1 then a2=a2-k1
  177. 1840  a3=int(a2/60):a4=a2-a3*60:a5=a3+9:if a5>23 then a5=a5-24
  178. 1850  a4=int(a2-a3*60+.5):if a4=60 then a4=0:a3=a3+1
  179. 1860  if a3=24 then a3=0
  180. 1870  aa=a3*60+a4:goto 2220
  181. 1880  m1=((y1/m9)-int(y1/m9))*m9+10:if m1>m9 then m1=m1-m9
  182. 1890  gosub 2620:m8=360*m2:if m8>180 then l$="W"
  183. 1900  if m8<=180 then l$="E"
  184. 1910  if m8>180 then m8=360-m8
  185. 1920  m1=int(m1+.5):m8=fnr(m8):return
  186. 1930  yy=int(7*(y1/7-int(y1/7))+.2):if yy=0 then yy=7
  187. 1940  k$=mid$(j$,(yy*3)-2,3):return
  188. 1950  q3=0:q1=e+180:if q1>360 then 1990
  189. 1960  if a2>e and a2<q1 then 1980
  190. 1970  q3=1:return
  191. 1980  q3=-1:return
  192. 1990  q1=q1-360:if a2<=360 and a2>e then 1980
  193. 2000  if q3<>0 then return
  194. 2010  if a2>0 and a2<=q1 then 1980
  195. 2020  if q3<>0 then return
  196. 2030  if a2>q1 then 1970
  197. 2040  return
  198. 2050  q5=q3*p(x,5)*4+aa:if q5<0 then q5=q5+k1
  199. 2060  if q5>k1 then q5=q5-k1
  200. 2070  p(x,6)=q5:q4=int(q5/60):q5=int(q5-q4*60+.5):if q5=60 then q5=0:q4=q4+1
  201. 2080  if q4=24 then q4=0
  202. 2090  return
  203. 2100  su=a5*60+a4:ps=su+360:ms=su-360:if ps>k1 then ps=ps-k1
  204. 2110  if ms<0 then ms=ms+k1
  205. 2120  if ms>ps then 2150
  206. 2130  if p(x,6)<ps and p(x,6)>ms then 2180
  207. 2140  qq$=" ":return
  208. 2150  if p(x,6)<k1 and p(x,6)>ms then 2180
  209. 2160  if p(x,6)<ps then 2180
  210. 2170  goto 2140
  211. 2180  qq$="*":return
  212. 2190  ll$=right$(str$(abs(ll)),2):if abs(ll)<10 then ll$=" "+right$(ll$,1)
  213. 2200  ? k$;"-- ";h$;str$(d);",";y;" ";ll$;dg$;:? mid$("SN",(ll<0)+2,1);
  214. 2210  retur0  retur0  retur0  retur0  returhen t3=t3+k1
  215. 460   if t3>k1 then t3=t3-k1
  216. 470   mt=t3-360:if mt<0 then mt=mt+k1
  217. 480   pt=t3+360:if pt>k1 then pt=pt-k1
  218. 490   poke contrl,32:poke contrl+2,0:poke contrl+6,1:rem trasparent write
  219. 500   poke intin,2:vdisys
  220. 510   gotoxy 5,0:? "--DAY'S SKY--  ";:gosub 2190:tim$="  "+r$+":"+t$
  221. 520   gotoxy 0,0:?:gotoxy 39,0:? tim$
  222. 530   for i=0 to 13:for j=0 to 39:screen%(j,i)=0:next:next
  223. 540   c=3:color 1:tm=val(r$+"."+t$):if tm<6 or tm>18 then c=1:color 3
  224. 550   poke contrl,25:poke contrl+2,0:poke contrl+6,1:rem set fill color
  225. 560   poke intin,c:vdisys
  226. 570   poke contrl,9:poke contrl+2,5:poke contrl+6,0:rem filled rectangle
  227. 580   restore 3040:for i=0 to 9:read zz:poke ptsin+i*2,zz:next
  228. 590   vdisys
  229. 600   xx=7+lc:gotoxy 5,xx
  230. 610   ? " - - - - - - - - - - - - - - - - - - - - - - "
  231. 620   poke contrl,25:poke contrl+2,0:poke contrl+6,1:rem change color
  232. 630   poke intin,2:vdisys
  233. 640   poke contrl,9:poke contrl+2,5:poke contrl+6,0:rem filled rectangle
  234. 650   restore 3050:for i=0 to 9:read zz:poke ptsin+i*2,zz:next
  235. 660   vdisys
  236. 670   gotoxy 5,15:color 1:gosub 300:gotoxy 5,16:color 0:if ll<0 then 700
  237. 680   if ll>24 then ? "E"spc(21)"S"spc(21)"W":goto 720
  238. 690   ? "UP-NORTH       ----OVERHEAD        DOWN-SOUTH":goto 720
  239. 700   if ll<-24 then ? "E"spc(21)"N"spc(21)"W":goto 720
  240. 710   ? "UP-SOUTH       ----OVERHEAD        DOWN-NORTH"
  241. 720   t4=aa:gosub 1100:y8=888
  242. 730   if y9=999 then 800
  243. 740   gosub 2820:y8=y9:if a1<0 then 800
  244. 750   if u9>17 or u9<4 then 800
  245. 760   u9=u9-3:y9=y9+15
  246. 770   gotoxy 0,0:?
  247. 780   screen%(54-y9,u9-2)=1
  248. 790   color 0:gotoxy 59-y9,u9:?chr$(42)
  249. 800   t4=aa+m2*k1:if t4>k1 then t4=t4-k1
  250. 810   color 1:if tm<6 or tm>18 then color 3
  251. 820   gosub 1100:if y9=999 then 880
  252. 830   mm=int(m1/9.83333)+1:gosub 1180
  253. 840   gosub 2820:if u9>17 or u9<4 then 880
  254. 850   u9=u9-3:y9=y9+15
  255. 860   screen%(54-y9,u9-2)=1
  256. 870   gotoxy 59-y9,u9:? chr$(mm)
  257. 880   for x=1 to 7:if x=7 then gosub 2710
  258. 890   if right$(b$,5)="COMET" and x=7 then 930
  259. 900   if x=7 then 1000
  260. 910   t4=p(x,6):gosub 1100:if y9=999 then 1000
  261. 920   u9=sin((p(x,6)/4)/(1/d9)):u9=int(-3*u9+.5)
  262. 930   gosub 2830
  263. 940   if u9<4 or u9>17 then 1000
  264. 950   u9=u9-3:y9=y9+15
  265. 960   z=screen%(54-y9,u9-2)
  266. 970   if z then u9=u9+sgn(ll)+(ll=0):goto 960
  267. 980   screen%(54-y9,u9-2)=1
  268. 990   gotoxy 59-y9,u9:? chr$(pp(x));
  269. 1000  rem dummy line
  270. 1010  next:color 1:gotoxy 40,17:? chr$(42);:gotoxy 0,0:?
  271. 1020  gotoxy 1,17:color 3:for x=1 to 6:?chr$(pp(x));p$(x);" ";:next
  272. 1030  ? " *SUN )O(MOON";
  273. 1040  gotoxy 0,0:?:gotoxy 40,17:? "ONEW MOON+SUN ";b$;:gotoxy 0,0:?
  274. 1050  color 2:gotoxy 47,15:? "T- NEW TIME, D- DATE,"
  275. 1060  gotoxy 47,16:? "P- P. TABLE, L- LAT";:sl=49
  276. 1070  poke contrl,32:poke contrl+2,0:poke contrl+6,1:rem normal write
  277. 1080  poke intin,1:vdisys
  278. 1090  color 1:goto 2360
  279. 1100  y9=999:if mt<pt then 1140
  280. 1110  if t4<mt and t4>pt then return
  281. 1120  if t4<mt or t4>k1 then t4=t4+k1
  282. 1130  goto 1150
  283. 1140  if t4<mt or t4>pt then return
  284. 1150  y9=int((t4-mt)/18+.5):if y9=40 then y9=39
  285. 1160  return
  286. 1170  u9=LATTITUDE":gotoxy sl,8:? "--------------"
  287. 2920  gotoxy sl,9:? "LAT (0-90)";:gosub 2810:if i$<>"" then ll=val(i$)
  288. 2930  if abs(ll)>90 then gotoxy sl+3,10:? oo$:goto 2920
  289. 2940  gotoxy 20,17:gosub 2590:if i$="N" or i$="n" then 2900
  290. 2950  a1=(sgn(ll)-(ll=0))*s+90-abs(ll):a1=fnr(a1)
  291. 2960  gotoxy sl,9:? spc(78-sl)
  292. 2970  gosub 2860:i$="S":goto 2380
  293. 2980  ci=1:c2$=""
  294. 2990  c1$=mid$(cd$,ci,1):if c1$<>" " then 3010
  295. 3000  c2$=c1$+c2$:ci=ci+1:goto 3020
  296. 3010  c2$=mid$(cd$,ci,2)+c2$:ci=ci+2
  297. 3020  if ci<4 then 2990
  298. 3030  cd$=c2$:return
  299. 3040  data 45,32,412,32,412,157,45,157,45,32
  300. 3050  data 45,158,412,158,412,175,45,175,45,158
  301. 3060  gotoxy 0,17:? "                                       ";
  302. 3070  gotoxy 0,0:?:gotoxy 34,17:? "                                    ";
  303. 3080  gotoxy 0,0:?:gotoxy 47,15:? "                      "
  304. 3090  gotoxy 47,16:? "                       ":return
  305. 3100  text$="SKYSCAPE ":tx=20:ty=10:fx=40:fy=40
  306. 3110  fullw(2):clearw(2)
  307. 3120  poke contrl,12:poke contrl+2,1:poke contrl+6,0:rem character height
  308. 3130  poke ptsin,0:poke ptsin+2,180:vdisys
  309. 3140  poke contrl,106:poke contrl+2,0:poke contrl+6,1:rem text effects
  310. 3150  poke intin,21:vdisys
  311. 3160  poke contrl,22:poke contrl+2,0:poke contrl+6,1:rem text color
  312. 3170  poke intin,2:vdisys
  313. 3180  poke contrl,11:poke contrl+2,2:poke contrl+6,len(text$)+2:poke contrl+10,10
  314. 3190  poke ptsin,tx*8:poke ptsin+2,ty*8:poke ptsin+4,len(text$)*40
  315. 3200  poke ptsin+6,0:poke intin,1:poke intin+2,1:rem justified text
  316. 3210  for i=1 to len(text$):poke intin+(i-1)*2+4,asc(text$)
  317. 3220  text$=right$(text$,len(text$)-1):next:vdisys
  318. 3230  poke contrl,12:poke contrl+2,1:poke contrl+6,0:rem reset normal text
  319. 3240  poke ptsin,0:poke ptsin+2,6:vdisys
  320. 3250  poke contrl,106:poke contrl+2,0:poke contrl+6,1:poke intin,0:vdisys
  321. 3260  poke contrl,22:poke contrl+2,0:poke contrl+6,1:poke intin,1:vdisys
  322. 3270  poke contrl,23:poke contrl+2,0:poke contrl+6,1:rem fill style
  323. 3280  poke intin,2:vdisys
  324. 3290  poke contrl,24:poke contrl+2,0:poke contrl+6,1:rem fill index
  325. 3300  poke intin,5:vdisys
  326. 3310  poke contrl,25:poke contrl+2,0:poke contrl+6,1:rem fill color
  327. 3320  poke intin,1:vdisys
  328. 3330  poke contrl,103:poke contrl+2,1:poke contrl+6,1:rem fill background
  329. 3340  poke ptsin,fx:poke ptsin+2,fy:poke intin,-1
  330. 3350  vdisys
  331. 3360  rem 2 lines change fill index and color
  332. 3370  poke contrl,25:poke contrl+2,0:poke contrl+6,1:poke intin,3:vdisys
  333. 3380  poke contrl,24:poke contrl+2,0:poke contrl+6,1:poke intin,2:vdisys
  334. 3390  restore 3450:a=0:while a>=0
  335. 3400  read a,b:poke contrl,103:poke contrl+2,1:rem fill letters
  336. 3410  poke contrl+6,1:poke intin,-1:poke ptsin,a:poke ptsin+2,b:vdisys
  337. 3420  wend:restore:rem reset fill color
  338. 3430  poke contrl,23:poke contrl+2,0:poke contrl+6,1:poke intin,1:vdisys
  339. 3440  return
  340. 3450  data 175,70,215,70,255,70,295,70,335,70,375,70,415,70,455,70,-1,-1
  341. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə